00100	C*****  SUBRS NOTES, BMX, ACSHFT  ***********
00200	
00300		SUBROUTINE NOTES
00400		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00500		COMMON/SCX/RHY(4),JALPHA(30),JX,RA,JZ,IRHY,RB,KA,KB,IZ
00600		COMMON /XRN/RN(2000) /DPY/ST(4000),WDS(250),MEDIT,GO	
00700		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,
00800		1 IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /ALF/CLF,JQX,D,
00900		1 KQ,JG,X,ACC,STMDR,Y,LL,RZ,RC,INP(61) /POS/POS1,POS2,R4
01000		1 /FRMT/F78F(1),FA1(1),FA5(1),ASK
01100		COMMON/RINP/R(10,80),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,
01200		1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB
01300		DATA ACMV/2.3/
01400		RMODE=0
01500		IF(RMODE2.GE.500)RMODE=RMODE2
01600	C  RMODE2≥500 IS FOR USER-ADDED NOTE AND REST ROUTINE (SUBR EXTRA)
01700	CP	POS1=0
01800	CP	POS2=200
01900		STFLG=0
02000	444	FORMAT(' TYPE POS1, POS2, (SPC)  '$)
02100		CALL SETUP
02200		IF(STUP.GE.0)GO TO 8
02300	CC	IF(ST(3601).GE.0)GO TO 8
02400	C   ST(3601) IS LOC. OF RPOS(1,1)
02500	C SKIPS IF USING SETUP ON SOME STAFF
02600		IF(POS2.NE.0)GO TO 4334
02700	C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP  ST  POS1  POS2  X)
02800	4333	TYPE 444
02900		ACCEPT F78F,POS1,POS2,R4
03000	C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
03100		IF(POS2.EQ.0)POS2=200.
03200		IF(POS1.GE.POS2)GO TO 4333
03300	C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
03400	4334	STUP=STUP-R4
03500	8	KN=0
03600		IRHY=0
03700	C  IZ=# OF ITEMS FROM SCANR*******
03800		IZ=I-1
03900	C  LIMIT OF 100 ITEMS***** 4/74 *****
04000		CLF=0
04100		KCLF=0
04200		JCLF=0
04300	C  DEFAULT IS ALWAYS TREBLE CLEF
04400	
04500		IF(POS2.NE.0)GO TO 71
04600		POS2=200
04700	71	K=IZ+1
04800		DO 70 KQ=1,IZ
04900		X=V(KQ)
05000		IF(X.GE.0)GO TO 70
05100		IF(-X.LT.2000)K=K-1
05200	C TO GET THE RIGHT ITEM COUNT WITH CHORDS, ETC.
05300	70	CONTINUE
05400	
05500		D=(POS2-POS1)/K
05600	C   D WILL SPACE ALL ITEMS EVENLY FOR NOW
05700	
05800		STEM=-1
05900	C   K=COUNTER FOR USEFUL ITEMS (OMITS CLEFS)
06000		K=1
06100		KQ=1
06200	C   LOOPS TO 7333 
06300	7	JG=-1
06400		X=V(KQ)
06500	C notes =  1xyz.0   x=accidental, yz=note num.,  negative=chord note
06600	C rest  =  2xyz.0   z=0=ordinary, =1=invis., =2=whole, =3=repeat bar
06700	C                   =4=down, =5=up, -2xyz=num. of meas. rest
06800	C clefs =  3xyz.0   z=0=treble, =1=bass, =2=alto, =3=tenor, neg.=invis.
06900	C bars  =  4xyz.0   z=num. of staves up, neg.=dbl.bar
07000	C ksig  = 17xyz.0   z=num. of accis.,  pos.=#, neg.=b
07100	C meter = 18xyz.n   xy=top num, zn=bottom num	(DONE IN SCMSS)
07200	C stem  =  5xyz.0   YZ=10=stem up,  =20=stem down
07300	C staff =  5xyz.0   z=0=return to norm., =1=lower stf., =2=upper stf.
07400	
07500		IF(X)GO TO 27
07600	C NEXT SORTS OUT ORDER OF CHORD
07700		RZ=V(KQ+1)
07800		IF(RZ.GT.0)GO TO 27
07900		IF(ABS(RZ).GE.2000)GO TO 27
08000	C  SKIPS NON-NOTES  
08100	327	RZ=AMOD(X,100.0)
08200	57	LL=KQ
08300		Y=0
08400		RA=RZ
08500	37	LL=LL+1
08600		STMDR=RA
08700		RA=-V(LL)
08800		IF(RA)GO TO 27
08900	C  EXITS WITH NON-NOTES OR NON-CHORD NOTES.
09000		RA=AMOD(RA,100.0)
09100	C  GETS RID OF ACCI. FOR NOW
09200		IF(RA.GE.99)GO TO 27
09300		IF(Y)127,97,67
09400	C Y IS STEM DIRECTION.  -1=DOWN, 1=UP
09500	97	Y=RA-STMDR
09600		GO TO 37
09700	67	IF(RA.LT.RZ)V(LL)=V(LL)-7
09800	C TRAP FOR NOTE IN WRONG OCT. (CONFUSES STEM DIRECTION.)
09900		IF(RA.GE.STMDR)GO TO 37
10000	227	CALL EXCH(V(LL),V(LL-1))
10100	C NOW START OVER AGAIN
10200		GO TO 57
10300	127	IF(RA.GT.RZ)V(LL)=V(LL)+7
10400		IF(STMDR.GT.RA)GO TO 37
10500		GO TO 227
10600	27	R4=0
10700		R5=0
10800		R6=0
10900		R8=0
11000		DO 89 LL=2,10
11100	89	R(LL,K)=0
11200	C   TO CLEAR END OF ITEM
11300		KODE=ABS(X)/1000
11400		IF(X.LT.0)GO TO 86
11500	C  JUMP IF A CLEF OR BAR OR METER
11600		IF(KODE.LE.2)IRHY=IRHY+1
11700	C   ADDS A RHYTHMIC UNIT
11800	C  TO CLEAR LAST PARAMS IN SOME ITEMS LATER
11900	86	GO TO (21,22,23,24,25),KODE
12000		IF(KODE.EQ.17)GO TO 1700
12100	C  NEXT IS FOR METERS
12200		L=(X-18000.)/10
12300		R5=L
12400	C   GETS TOP NUM OF METER
12500		R6=AMOD(X,10.0)*10.0+.01
12600		GO TO 843
12700	
12800	23  	CLF=ABS(X)-3000.
12900		JCLF=CLF
13000		IF(X)GO TO 871
13100	C  IS THE CLEF INVISIBLE?
13200		R5=CLF
13300		IF(KCLF)R4=R4+100
13400	C  MINI CLEF AFTER 1ST REGULAR SIZE.
13500		KCLF=-1
13600		GO TO 843
13700	
13800	25	Y=X-5000
13900		IF(Y.LT.10)GO TO 250
14000	C  NEXT FOR STEM UP, DOWN
14100	C DOWN = 20 (5020), UP=10 (5010)
14200		STEM=Y
14300		GO TO 871
14400	250	STFLG=Y
14500	C  STAFF ABOVE=2, BELOW=1, RESET=0
14600		GO TO 871
14700	
14800	24	R4=ABS(X)-4000
14900		CALL NOZERO(R4)
15000		IF(X)R4=R4+1500
15100	C  NEG =DBL BAR.
15200		GO TO 843
15300	
15400	1700	R5=ABS(X)-17000.
15500	C KEY SIGS    NEG=FLATS
15600		IF(X)R5=-R5
15700		R6=CLF
15800		GO TO 843
15900	
16000	22	Y=ABS(X)-2000
16100		IF(X)GO TO 831
16200		IF(Y.EQ.0)GO TO 843
16300	C  ORDINARY REST=0
16400		IF(Y.LT.4)GO TO 882
16500	C  REST UP=5, DOWN=4
16600		R4=6
16700		IF(Y.EQ.4)R4=-R4
16800		GO TO 843
16900	
17000	882	IF(Y.EQ.1)GO TO 885
17100		IF(Y.EQ.2)GO TO 886
17200	C NEXT FOR REPEAT SIGN
17300		R5=-4
17400		GO TO 887
17500	
17600	885	R8=9999
17700	C ↑↑ FOR INVIS. REST
17800		GO TO 843
17900	
18000	886	R8=-1
18100	C ↑ FOR WHOLE REST (ANY RHYTHM)
18200	887	R(9,K)=-1
18300		GO TO 843
18400	
18500	831	R8=Y
18600	C  NUMS OF BARS REST
18700		GO TO 887
18800	
18900	21	R(10,K)=STFLG
19000		IF(X.GT.0)GO TO 210
19100		X=-X
19200		R8=-1
19300	C  CHORD NOTE
19400		JG=0 
19500	210	LL=X-1000
19600	C  NOTES
19700		L=LL/100
19800	C  THE ACCI.
19900		R5=L
20000		N=MOD(LL,100)-1
20100	C  THE NOTE NUM.
20200		L=N/7
20300	C OCT. NUM HERE IS 1 .GT. THAN THAT TYPED.  (OCT. 0 IS POSSIBLE NOW.)
20400		N=MOD(N,7)+1
20500	C  ABSOLUTE NOTE NUM.
20600		KA=JCLF*12
20700	C  THIS WILL ADJUST FOR CLEF NUM.
20800		IF(JCLF.GE.2)KA=JCLF*2+2
20900		R4=(L-4)*7+KA+N
21000		STMDR=10.
21100		IF(R4.GE.7)STMDR=20.
21200	CO	IF(STEM.GT.0)STMDR=STEM
21300		IF(STEM.LE.0)GO TO 26
21400		STMDR=STEM
21500	C  SHORTEN STEMS WHEN TURNED TO NON-STANDARD DIRECTION.
21600	CCC NO NO NO -- THIS USED ESLWHERE.	R8=-1
21700	C  FOR STEM DIRECTIONS - 'B' AND HIGHER HAVE STEMS DOWN.
21800	CO	IF(JG)GO TO 3133
21900	C  JUMP IF NOT DBLSTOP
22000	26	IF(JG.GE.0)GO TO 6
22100	C  NEXT LENGTHENS STEMS FOR VERY HIGH OR VERY LOW NOTES.
22200		IF(STMDR.EQ.20)GO TO 16
22300	C NEXT FOR STEM UP
22400		IF(R4.LT.0)R8=-R4
22500	C  STEMS OF VERY HIGH OR VERY LOW NOTES WILL ALWAYS TOUCH MIDDLE LINE
22600		GO TO 3133
22700	16	IF(R4.GT.14)R8=R4-14
22800	C SEE 'BEAMS' AT 143 FOR SIMILAR FEATURE
22900		GO TO 3133
23000	6	L=K-1
23100		IF(R(5,L).GE.10.)MX=L
23200	C  MX=1ST NOTE OF CHRD
23300		STMDR=0
23400		L=K-MX
23500		IF(R4.LT.R(4,MX))L=-L
23600		R(7,MX)=L
23700	C L+=STEM UP, L-=STEM DOWN ... USED AT END OF NOTES.
23800		X=ABS(R(4,MX)-R4)-1.
23900	C  EXTENDS THE STEM!
24000	C  AFTER 1ST NOTE, ORDER MAY BE SCRAMBLED IN CHORDS.  STEM OK.
24100		IF(X.LT.1.)X=1.
24200		IF(R(8,MX).LT.X)R(8,MX)=X
24300	3133	R5=R5+STMDR
24400	
24500	843	R(4,K)=R4
24600		R(5,K)=R5
24700		R(6,K)=R6
24800		R(8,K)=R8
24900	CS	R(2,K)=STAFF
25000		IF(JG)KN=KN+1
25100		R(3,K)=KN*D+POS1
25200		R(1,K)=KODE
25300	87	K=K+1
25400	871	KQ=KQ+1
25500		IF(KQ.LE.IZ)GO TO 7
25600	
25700		IZ=K-1
25800	C  IZ IS NOW REALLY THE NUMBER OF ITEMS TO BE PROCESSED
25900	C  NEXT ADJUSTS PLACEMENT OF ACCIDENTALS AND 2NDS.
26000		K=1
26100	1	RX=R(7,K)
26200		IF(RX.EQ.0)GO TO 2
26300		IF(R(1,K).EQ.2.)GO TO 2
26400	C  JUMP IF NO CHRD COMING
26500		IF(RX.GT.0)GO TO 3
26600	C  JUMP IF STEM IS UP
26700		RA=R(5,K)
26800		IF(RA.LT.10)GO TO 277
26900		IF(RA.LT.20.)R(5,K)=RA+10.
27000	C  PUTS STEM DOWN IF IT WASN'T
27100	277	L=K-RX
27200	C  RX=TOTAL(-1) NOTES IN CHORD
27300		R(7,K)=0
27400	4	RA=R(4,K)
27500		RC=0
27600	C  INTERVAL TO PREVIOUS NOTE
27700	C  CHECK ON USE OF N ELSEWHERE
27800		N=K+1
27900		IF(K.LT.L)RC=RA-R(4,N)
30200	220	CALL ACSHFT(RX)
30300	C  L=K-1=END OF CHORD;  L-ABS(RX)=START OF CHORD; +RX=↑  -RX=↓
30400		GO TO 222
30500	
30600	2	K=K+1
30700	222	IF(K.LE.IZ)GO TO 1
30800		R(1,K)=0
30900		END
31000	
31100		SUBROUTINE BMX(RA)
31200	C  RA=NUMB. OF TAILS
31300		COMMON/RINP/R(10,80),VQ(100)
31400	C  VQ HOLDS TEMPORARY INFO RE. MULTIPLE BEAMS.
31500		COMMON E,F,G,H,RJQ(34),RB,VQX,JB,B,JV,JW /XRN/RN(2000)
31600		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
31700		COMMON /STF/RSTFAC(0/7),RSTJ2
31800		COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
31900		COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /SC/J,L,MK
32000		1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
32100		1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
32200		M=IS-12
32300		DO 1 L=KN,K
32400	1	VQ(L)=AMOD(R(7,L),10.0)
32500		VQ(K+1)=0
32600	C   CLEARS IT FOR ROUTINE AT '3'
32700		JB=KN
32800	
32900	6	DIS=0
33000		RB9=0
33100		DO 2 L=JB,K
33200		IF(VQ(L).LE.RA)GO TO 2
33300	C  SKIP IF EQ. TO PRESENT BEAM
33400		RB=VQ(L)
33500	4	DO 11 JD=L,K
33600		VQX=VQ(JD)
33700		IF(VQX.GE.RB)GO TO 20
33800		IF(VQX.EQ.0)GO TO 11
33900	C  VQX=0 ON NON-STEM NOTES OF CHORDS. (HENCE NO TAILS)
34000	21	B=10.
34100		IF(L.GT.KN)GO TO 13
34200		GO TO 16
34300	20	JV=JD
34400		IF(VQX.GT.RB)GO TO 21
34500	11	JW=JD
34600		B=20
34700	C  FINDS NEED FOR BEAM TO LEFT 
34800	16	B=B+RA
34900		DO 5 JE=1,6
35000	5	RN(JE+IS)=RN(JE+M)
35100		RN(7+IS)=RN(7+M)+RB-RA*2.
35200	C  ADDS RIGHT NUM. OF BEAMS
35300		IF(L.NE.JV)GO TO 10
35400		IF(L.EQ.KN)GO TO 377
35500		IF(L.NE.K)GO TO 10
35600	377	B=-B
35700	C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
35800		GO TO 8
35900	13	IF(JV.GT.L)GO TO 14
36000		IF(R(7,L+1).LT.10)GO TO 15
36100	C NEXT FOR DOT ON FOLLOWING NOTE.
36200		DIS=10.
36300		GO TO 19
36400	15	DIS=20.
36500	C SHORT INNER BEAM TO LEFT OF STEM
36600	19	B=-RA
36700		GO TO 16
36800	14	DIS=30
36900	C  LONG INNER BEAM
37000		JV=-JV
37100		GO TO 16
37200	
37300	C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
37400	10	IF(L.EQ.KN)GO TO 22
37500		IF(JV.GE.0)GO TO 17
37600		B=R(3,L)
37700		JV=-JV
37800		L=JV
37900	22	IF(VQ(JW+1).GT.VQ(JW))GO TO 17
38000		VQ(JW)=VQ(JW+1)
38100		JW=JW-1
38200	17	IF(L.NE.JB)GO TO 18
38300		IF(B.LT.20.)L=JV
38400	C PUTS BEAMS IN RIGHT PLACE.
38500	18	RC=R(10,L)
38600		IF(RC.EQ.0)GO TO 23
38700		RB=2.44*RSTJ2
38800		IF(ABS(R(4,L)).GE.100)RB=RB*.6
38900	C  GET WIDTH OF NOTE FOR DISPLACEMENT
39000	CC18	RB9=R(3,L)
39100		IF(RC.EQ.2)RB=-RB
39200		RC=RB
39300	CCC	B=B+RC
39400	23	RB9=RC+R(3,L)
39500	C  THIS WILL BE POS.3
39600		DIS=RA+DIS
39700	C  DISPLACES
39800		GO TO 8
39900	2	CONTINUE
40000		RETURN
40100	8	JB=JW+1
40200	C  FINDS SIDE (L,R) FOR PARTIAL BEAM
40300	C  FOR NEW DISPLACEMENT
40400		RN(IS+11)=-1
40500		IF(RB9+DIS.EQ.0)GO TO 31
40600		IF(DIS.LT.10)GO TO 32
40700		IF(DIS.LT.30)GO TO 33
40800	C INNER PARTIAL BEAM IS NEXT
40900		DIS=DIS-30
41000		GO TO 31
41100	32	IF(B.GE.20)GO TO 12
41200		DIS=B-10
41300		B=-1
41400	C  -1 PICKS UP POS OF P3
41500	CC	B=RN(3+M)
41600		GO TO 31
41700	12	DIS=B-20
41800		B=RB9
41900		RB9=-1
42000	C  -1 IN P9 WILL PICK UP POS OF P6
42100	CC	RB9=RN(6+M)
42200	C  INNER BEAM ATTACHED TO LFT SIDE.
42300		GO TO 31
42400	33	B=-DIS
42500		DIS=0
42600	31	RN(8+IS)=B
42700		RN(9+IS)=RB9
42800		RN(10+IS)=DIS
42900		CALL UPDATE(9)
43000	C  ADDED ANOTHER ITEM (PART. BEAM)
43100		IF(JB.LE.K)GO TO 6
43200		END
43300	
43400		SUBROUTINE ACSHFT(RX)
43500		COMMON /XRN/RN(2000) /STF/RSTFAC(0/7),RSTJ2
43510		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
43600		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
43700		1,DBST,NFLG,IXX,ISEMI,IQT,F(50),IAMP,K,KN,M,MODE,IBLA
43800		COMMON/RINP/R(10,80),VQ(100)
43900		EQUIVALENCE (A,F(1)),(B,F(2)),(X,F(4)),
44000		1(Y,F(5)),(Z,F(6)),(JD,F(7)),(RN1,F(8)),(RH,F(9))
44100		Z=0
44200		L=K-1
44300		M=L-ABS(RX)
44400		JD=1
44500		RN1=99
44600		Y=-.23
44700		IF(RX.LT.0)GO TO 1
44800		L=M
44900		M=K-1
45000		JD=-1
45100	1	DO 2 N=M,L,JD
45200	C  DOES IT HAVE AN ACCID?
45300		IF(AMOD(R(5,N),10.).EQ.0)GO TO 2
45400		A=0
45500		B=0
45600		IF(N.LT.L)A=R(6,N+1)
45700		IF(N.GT.M)B=R(6,N-1)
45800		IF(RN1.NE.99)GO TO 3
45900	C  IS THIS THE FIRST ACCID?
46000		RN1=R(4,N)
46100		GO TO 6
46200	3	RH=R(4,N)
46300		IF(ABS(RH-RN1).LT.5)GO TO 4
46400		RN1=RH
46500		IF(Y.GT.0)Z=Z+.04
46600	C STOPS OCT., ETC. ACCIS BEING MOVED TO LEFT.
46700		Y=-.23+Z
46800	6	IF(A.EQ.20)GO TO 477
46900		IF(B.NE.20)GO TO 4
47000	477	Y=Z
47100	4	X=0
47200		IF(R(6,N).EQ.20)X=-.24
47300		IF(R(6,N).EQ.10)X=.24
47400		Y=Y+.23
47500		IF(X+Y.LT.1)GO TO 7
47600		RN1=RH
47700		Z=Z+.04
47800		Y=0
47900		IF(A.EQ.20)GO TO 677
48000		IF(B.NE.20)GO TO 577
48100	677	Y=.23
48200	C  SO Y DOESN'T GET >1.
48300	577	Y=Y+Z
48400	7	X=X+Y
48500		IF(ABS(X-.04).LT..01)X=0
48600		IF(X.GE.0)GO TO 5
48700		Y=.23+Z
48800		X=Z
48900	5	R(5,N)=R(5,N)+X*RSTFAC(IFIX(STAFF))
48950	C  SPACING OF ACCI. DEPENDS ON STAFF SIZE FACTOR AT THIS POINT
49000	2	CONTINUE
49100		END
49200	
49300		SUBROUTINE TYPOUT
49400		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,
49500		1 IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /ALF/INP(72),ML
49600		DO 1 KK=72,1,-1
49700	1	IF(INP(KK).NE.IBLA)GO TO 2
49800	2	TYPE 3,MODE,(INP(J),J=1,KK)
49900	3	FORMAT(I2,4X,72A1)
50000		END